module PPrintDataPieces where

import DataPieces
import Utils
-- import System.IO.Unsafe ( unsafePerformIO )
-- 
-- debug0 :: String -> a -> a
-- debug0 str x = unsafePerformIO (putStrLn ("DEBUG: ***"++ str++"***")) `seq` x

-- ****************************************************************
-- *                                                              *
-- *              Pretty printer                                  *
-- *                                                              *
-- ****************************************************************
data ModePrint = Output | Latex !String !Char
isLatex (Latex _ _) = True
isLatex _           = False

pprint :: ModePrint -> STGProgram -> String
pprint mode prog = iDisplay $ pprProgram mode prog

showEcs :: [Bind] -> String
showEcs ecs = iDisplay $ iStr "      " `iAppend` iIndent (pprBinds Output ecs)

showBind :: Bind -> String
showBind ec = showEcs [ec]

showBinds :: [Bind] -> String
showBinds binds = iDisplay $ pprBinds Output binds

showLf :: Bind -> String
showLf lf = iDisplay $ iIndent $ pprLfBind Output lf

showExpr :: STGExpr -> String
showExpr e = iDisplay $ iIndent $ pprExpr Output e

showLs :: (String,[String]) -> String
showLs (sName,[]) = sName++"[]"
showLs (sName,strs) = sName++"[" ++ foldl1 (\x y -> x ++ ",\n" ++ sep ++ y) strs ++ "]"
   where 
       sep = take (length sName) $ repeat ' '

showAlts :: [Alt] -> String
showAlts alts = iDisplay $ iIndent $ pprAlts Output alts

pprExpr :: ModePrint -> STGExpr -> Iseq 
pprExpr mode@(Latex a b)  (ELet defns expr) 
  = iIndent (iConcat [  iStr "\\letE", iBlanco mode, iStr "\\ldtos", iStr "\\inE ",pprExpr mode expr 
--                          iNewline, 
--                         iStr "  ", iIndent (pprBinds mode defns), iNewline,                        
             ])
pprExpr mode@(Latex a b) (ECase expr alts)
  = iIndent (iConcat [iStr "\\caseE~",pprExpr mode expr, iStr "~\\ofE", iBlanco mode, pprAlts mode alts
             ])
pprExpr mode@(Latex _ _) (ECons c exprs) = (iStr ("\\"++c)) `iAppend` iBlanco mode `iAppend` (pprExprs mode exprs)
pprExpr mode@(Latex _ _) (ELamb args expr)
  = iIndent (iConcat [  iStr "\\lambda ",pprPats mode args,iStr ".~",pprExpr mode expr])
pprExpr mode (ELet defns expr)
  = iIndent (iConcat [  iStr "let", iNewline,
                        iStr "  ", iIndent (pprBinds mode defns),iNewline,
                        iStr "in ",pprExpr mode expr ])
pprExpr mode (EIf eB eT eF)
  = iIndent (iConcat [  iStr "if ", pprExpr mode eB,
                        iStr " then ", pprExpr mode eT,
                        iStr " else ",iNewline, pprExpr mode eF ])
pprExpr mode (ELamb args expr)
  = iIndent (iConcat [  iStr "\\ ",pprPats mode args, iStr " -> ", pprExpr mode expr])
pprExpr mode (ECase expr alts)
  = iIndent (iConcat [  iStr "case ",pprExpr mode expr,iStr " of",iNewline,
                        iStr "  ",iIndent (pprAlts mode alts) ])
pprExpr mode (EAp e exprs) 
      | isInfix e = iConcat [ pprExpr mode (exprs!!0), iStr " `", pprExpr mode e, iStr "` ", pprExpr mode (exprs!!1) ]
      | otherwise = pprExprS mode e `iAppend` iBlanco mode `iAppend` (pprExprs mode exprs)
pprExpr mode expr@(ECons c exprs)
      | c == ":" && (not.isFiniteList) expr =
                  let [e1, e2] = exprs
                  in iConcat [ pprExpr mode e1, iStr " : ", pprExpr mode e2 ]
      | c == ":" && isFiniteList expr =
                  iConcat [ iStr "[", iInterleave (iStr ", ") $ map (pprExpr mode) (toFiniteList expr), iStr "]"]
      | c == "Tupla" = iConcat [ iStr "(", iInterleave (iStr ", ") $ map (pprExprS mode) exprs, iStr ")"]
      | c == "ListaFinita" = iConcat [ iStr "[", iIndent $ iInterleave (iStr ", " `iAppend` iNewline) $ map (pprExpr mode) exprs, iStr "]"]
      | otherwise = (iStr c) `iAppend` iBlanco mode `iAppend` (pprExprs mode exprs)
pprExpr mode (EOpB op e1 e2) = iConcat [ pprExprS mode e1, iStr (opToString op), pprExprS mode e2 ]
pprExpr mode (EOpU op e1) = iConcat [ iStr (opToString op), pprExprS mode e1 ]
pprExpr mode (ELit n) = pprNum mode n
pprExpr mode (EVar v) = pprVar mode v
pprExpr mode (EStr str) = pprStr mode str
pprExpr mode (EVarAt v expr) = pprVar mode v `iAppend` iStr "@" `iAppend` pprExprS mode expr

pprExprs :: ModePrint -> [STGExpr] -> Iseq
pprExprs mode exprs = iInterleave sep (map (pprExprS mode) exprs)
                 where
                   sep = iBlanco mode

pprExprS :: ModePrint -> STGExpr -> Iseq
pprExprS mode expr 
        | isExprSimple expr = pprExpr mode expr
        | otherwise = iConcat [iStr "(", pprExpr mode expr, iStr ")"]
--         | otherwise = (iStr "(") `iAppend` pprExpr mode expr `iAppend` (iStr ")")
        
pprVar :: ModePrint -> Var -> Iseq
pprVar mode@(Latex _ _) v = iStr ("\\mathit{"++v++"}")
pprVar mode v = iStr v

pprStr :: ModePrint -> Var -> Iseq
pprStr mode@(Latex _ _) v = iStr ("\\mathit{"++v++"}")
pprStr mode str = iStr ('"':str++"\"")

pprList :: ModePrint -> [Var] -> Iseq
pprList mode names = iInterleave (iBlanco mode) (map (pprVar mode) names)

pprAlts :: ModePrint -> Alts -> Iseq
pprAlts mode@(Latex a b) _ =
       iStr ("\\alts"++a)
pprAlts mode alts=
       iIndent( iInterleave sep ((map (pprAlt mode) alts)))
   where
     sep = iConcat [ iNewline ]
--     sep = iConcat [ iStr ";", iNewline ]

pprAlt :: ModePrint -> Alt -> Iseq
pprAlt mode (PAlt pat expr) 
  = iConcat [ pprPat mode pat, iStr " -> ", pprExpr mode expr ]
pprAlt mode (DefV  name expr)
  = iConcat [ iStr name, iStr " -> ", pprExpr mode expr ]
pprAlt mode (Def expr)
  = iConcat [ iStr "otherwise", iStr " -> ", pprExpr mode expr ]

pprNum :: ModePrint -> Literal -> Iseq
pprNum mode@(Latex _ _) n = iStr (show n)
pprNum mode n = iStr (show n)

pprBinds :: ModePrint -> [Bind] -> Iseq
pprBinds mode binds = iInterleave sep (map (pprBind mode) binds)
              where
                 sep = iNewline

pprBind :: ModePrint -> Bind -> Iseq
pprBind mode (pat, patsArgs, grds, whereExpr) 
  = iConcat [ pprPat mode pat, iBlanco mode, pprPats mode patsArgs, 
              iIndent (pprGrds mode grds), 
              pprWhereExpr mode whereExpr
            ]     

pprBindC :: ModePrint -> (String, Bind) -> Iseq
pprBindC mode (comment, bind) 
  = iConcat [ iStr comment, 
--               iNewline, 
              pprBind mode bind
            ]     

pprLfBind :: ModePrint -> Bind -> Iseq
pprLfBind mode (pat, patsArgs, grds, whereExpr)
  = iConcat [ pprPats mode patsArgs, iIndent (pprGrds mode grds), pprWhereExpr mode whereExpr ]


pprGrds :: ModePrint -> [(STGExpr,STGExpr)] -> Iseq 
pprGrds mode [(EVar "otherwise",expr)] = iStr " = " `iAppend` iIndent (pprExpr mode expr) 
pprGrds mode grds = foldl (\ z (x,y) -> iConcat [z, iNewline, iStr "| ", pprGrd mode x, iStr " = ", pprExpr mode y]) iNil grds

pprGrd :: ModePrint -> STGExpr -> Iseq 
pprGrd  = pprExpr

pprPats :: ModePrint -> [STGExpr] -> Iseq 
pprPats = pprExprs

pprPat :: ModePrint -> STGExpr -> Iseq 
pprPat = pprExpr

pprWhereExpr :: ModePrint -> WhereExpr -> Iseq 
pprWhereExpr mode (W []) = iNil
pprWhereExpr mode (W xs) = 
           iConcat [iNewline, iStr "   where", iIndent (iNewline `iAppend` pprBinds mode xs)]

pprProgram :: ModePrint -> STGProgram -> Iseq
pprProgram mode scdefns = iInterleave sep (map (pprBindC mode) scdefns)
                 where
                   sep = iNewline

isInfix (EVar x) = (x=="div") || (x=="mod") || (x=="rem")
isInfix _ = False


-- ********************* iType **************************
iBlanco :: ModePrint -> Iseq
iBlanco (Latex _ _) = iStr "~"
iBlanco _           = iStr " "

iSepLin :: ModePrint -> Iseq
iSepLin (Latex _ _) = iConcat [ iStr "\\\\", iNewline ]
iSepLin _           = iConcat [ iStr ";", iNewline ]

-- mkMultiAp :: Int -> CoreExpr -> CoreExpr -> CoreExpr
-- mkMultiAp n e1 e2 = foldll EAp e1 (take n e2s)
--                    where
--                    e2s = e2 : e2s
iNil     :: Iseq                  -- The empty iseq
iStr     :: String -> Iseq        -- Turn a string into an iseq
iAppend  :: Iseq -> Iseq -> Iseq  -- Append two iseqs
iNewline :: Iseq                  -- New line with indentation
iIndent  :: Iseq -> Iseq          -- Indent an iseq
iDisplay :: Iseq -> String        -- Turn an iseq into a string
iConcat     :: [Iseq] -> Iseq
iInterleave :: Iseq -> [Iseq] -> Iseq

data Iseq = INil
          | IStr String
          | IAppend Iseq Iseq
          | IIndent Iseq
          | INewline
          deriving(Show)


iConcat (x:xs) = iAppend x (iConcat xs)
iConcat [] = iNil

iInterleave y (x:x1:xs) = iAppend x (iAppend y (iInterleave y (x1:xs)))
iInterleave y [x] = x 
iInterleave y [] = iNil

iNil              = INil
iAppend INil seq2 = seq2
iAppend seq1 INil = seq1
iAppend seq1 seq2 = IAppend seq1 seq2
iStr "\n"            = INewline   
iStr str             = IStr str

iIndent seq = IIndent seq
iNewline    = INewline

flatten :: Int                       -- Current column; 0 for first column
            -> [(Iseq, Int)]         -- Work list
            -> String                -- Result

flatten col ((INewline, indent) : seqs)
  = '\n' : (space indent) ++ (flatten indent seqs)
flatten col ((IIndent seq, indent) : seqs)
-- = flatten col ((seq, (indent+2)) : seqs)
 = flatten col ((seq, col) : seqs)
flatten col ((IAppend iseq1 iseq2, indent) : seqs)
  = flatten col ((iseq1,indent) : (iseq2,indent) : seqs)
flatten col ((IStr s, indent) : seqs) = s ++ (flatten (col+length s) seqs)
flatten col ((INil, indent) : seqs)
 = flatten col seqs
flatten col [] = []

iDisplay seq = flatten 0 [(seq,0)]

iNum :: Int -> Iseq
iNum n = iStr (show n)

iFWNum :: Int -> Int -> Iseq
iFWNum width n
  = iStr (space (width - length digits) ++ digits)
    where
      digits = show n

iLayn :: [Iseq] -> Iseq
iLayn seqs = iConcat (map lay_item (zip [1..] seqs))
             where
             lay_item (n, seq)
               = iConcat [ iFWNum 4 n, iStr ") ", iIndent seq, iNewline ]

opToString (Add)    = " + "
opToString (Sub)    = " - "
opToString (Mult)   = " * "
opToString (Div)    = " div " 
opToString (Mod)    = " mod " 
opToString (Neg)    = " - " 
opToString (Gr)     = " > "
opToString (GrEq)   = " >= "
opToString (Lt)     = " < " 
opToString (LtEq)   = " <= " 
opToString (Eq)     = " == " 
opToString (NotEq)  = " /= "
opToString (And)   = " && " 
opToString (Or)    = " || "
opToString (ElemI)   = " !! " 
opToString (Concat)   = " ++ " 
opToString (Aplic)   = " $ " 
opToString (Comp)   = " . " 


